Developer CD Series 1994 August: Tool Chest/Dev.CD Aug 94.toast/Tool Chest/Development Platforms/Macintosh Common Lisp Related/User Contributions/qt-objects-29.lisp

Text File | 1994-06-16 | 83.5 KB | 2,168 lines | [TEXT/CCL2]

;;; this is qt-objects.lisp, version 2.9
;;; Last changed: March 22, 1994

(in-package :cl-user)

#|
This code provides an object-oriented interface to QuickTime
movies.  It defines the basic classes movie and movie-view.
Movie-windows, movie-windoids, and movie-dialog-items are also defined
as specializations of movie-view.  Clicking on movie-dialog-items is
like pressing a play-pause button.

To use qt-objects:
1) Make sure you have the QuickTime extension installed in your Extensions folder.
2) Load this file.
3) Evaluate (movie-test) to play a movie (you must have a movie on disk).

For best performance:
a.  Make sure you aren't scaling your movie.  Scaling slows down play.
b.  Don't use a controller.  Use the method play-movie* to play your movie.
c.  Try allocating enough Mac Heap space so that the movie will be loaded into ram (see
    the function set-mac-heap-size).

;;;                 EXAMPLES
;(please send more examples to [e-mail])
;1. A simple movie window
(movie-test) ; bring up a dialog to play a movie file
;2. A window with a movie view
(defvar *v*)
(defvar *w*)  ;create a window with a movie view
(setf *w*
      (make-instance 'window
        :color-p t
        :view-size #@(400 525) ;scales all movies to this size.
        :view-subviews
        (list
         (setf *v*
               (make-instance 'movie-view
                 :view-position #@(10 10)
;                :show-controller nil ;if you don't want a controller, set to nil
                 :movie
                 (make-instance 'movie
                   :file (choose-movie-dialog)))))))
;3. Changing a movie
;change the movie in the view
;It, unfortunately, sizes the movie to the movie view
(setf (view-movie *v*) (make-instance 'movie :file (choose-movie-dialog)))
;4. Hiding/showing a movie view (if you don't already have a view hide method)
;hide movie
(set-view-position *v* (add-points (view-position *v*) #@(2000 2000)))
;show movie
(set-view-position *v* (subtract-points (view-position *v*) #@(2000 2000)))
;5. Play a movie with play-movie* (if you don't have a controller)
(play-movie* (view-movie *v*))
;;;                END EXAMPLES

Please send comments or improvements to [e-mail]

Authors:
Kemi Jona ([e-mail])
Mike Korcuska ([e-mail])
Jeff Lind ([e-mail])
David Neves ([e-mail])

The Institute for the Learning Sciences
Northwestern Unversity
1890 Maple Ave
Evanston, IL 60201

- and -

Marc Davis ([e-mail])
Mike Travers ([e-mail])
Brian Williams ([e-mail])

Media Laboratory
Learning and Common Sense Group
Massachusetts Institute of Technology
Cambridge, MA 02139


New features/Changes
====================
  (Version 2.9)
- Fixed 10k memory leak when new movies w/ controllers were created (multiple
  controllers were being created for a single movie and only 1 was disposed of).
  Update-for-new-movie now checks to see if the view is within
  a window (otherwise with-focused-view doesn't do anything reasonable) and
  install-view-in-window on movie views is changed to an after method so that the
  initialization of a movie-view gets done when it is within a window. -David
- wrap several methods in without-interrupts so that event-processing can't sneak in
  and cause problems. -Jeff L, David
  (Version 2.8)
- add simple-view specialization for add-child-movie-views
  (Version 2.7)
- Code from Bill St. Clair to keep track of movie-views so that they can be correctly
  positioned when their ancestor views are moved.
  Changes to Bill's code. -David
- Set the minimum mac heap size in enhance-movie-playback so that movies play smoothly.
  Change zero's in enhance-movie-playback to calls to get-movie-time.
  Rewrite quicktime-event-hook
  Quicktime-event-hook now works with combinations of controller and non controller
  video views.
  Removied call to #_ExitMovies in end-quicktime.  Current Apple advice is to not to call
  #_ExitMovies in an application. -David
- now setting *idle-sleep-ticks* to optimize playback performance - David
- enhance-movie-playback now works properly - David
- use set-mac-heap-size to allocate memory for your movies in RAM to
  realy increase performance - David
- movie-windows with controller and grow-icon now don't change movie
  box size (Kemi J- thanks to David N for pointing out the bug)
- handles to movies now made unpurgeable - this should help avoid crashes (Kemi J)
- checks for valid handles inserted - this should eradicate alot of
  crashes (Jeff L)
- filespec stuff cleaned up (major thanks to Mike K). Additional notes
  regarding this cleanup at end of this file
- creating a movie-view without installing it in a window is now
  kosher (thanks to Jeff L)
- "empty" movie-views now supported - supply nil for movie-pathname,
  or just don't pass movie-view a movie object (also due to Jeff L)
- new function that returns the time of a movie frame or range of frames
  in a human readable (SMPTE-format) string (by Kemi J)
- looping and palindrome play modes now supported (Kemi J)
- controller play/pause button now reflects current state of
  movie after call to play-movie - you must call play-movie on the
  movie-view, not on the movie itself.  See comments for play-movie
  methods (also by Kemi J) - this broke in QT 1.6
- slightly modified eventhook - this may prevent some crashes (?)
- new variable *signal-error-if-no-quicktime* [default T].  Set to nil if
  you don't want an error signalled at Lisp startup in images that are run
  on machines w/ no quicktime.
- code to get movie from a resource handle (Peter Stone) so movies can be stored
  in the resource fork of a saved application (for example)

Known Problems/ stuff to do:
============================

- need to figure out why the play/pause button isn't working anymore
- movie-view not drawing after an add-subviews call (this should be fixed now)
- make QT package and export functions
- frames-per-second is a global; should be local
- would be nice to have a SMPTE time-format to frame conversion
  function so user can enter HH:MM:SS.FF and have the movie jump to the
  frame corresponding to that time
- add a movie-done-function slot to movie-views that would contain a function
  to be called when movie was finished playing - check for this in eventhook?
- more support for various options: drawing badge, suppressing volume/step keys, etc
- handling edit menu via trap calls (e.g. #_McSetUpEditMenu)? this may eliminate
  some complexity in Lisp code but may make things more opaque to developers.

OUTLINE OF THIS FILE:
=====================

SUPPORT FUNCTIONS FROM QUICKDRAW.LISP

MOVIE CLASS

ROUTINES FOR GETTING AND PLAYING MOVIES
     Initializing the System
     Error Routines
     Movie File Routines
     Loading and Unloading Movies
     Saving Movies
     Controlling Movie Playback
     Movie Posters and Previews
     Movies and Your Event Loop
     Preferred Movie Settings
     Enhancing Movie Playback Performance
     Disabling Movies
     Generating QuickDraw Pictures From Movies
     Application-Defined Movie Routines

ROUTINES FOR EDITING MOVIES
     Editing Movies
     Low-Level Movie Editing Routines

ROUTINES THAT MODIFY MOVIE PROPERTIES
     Working With Movie Spatial Characteristics
     Working With Sound Volume
     Working With Movie Time
     Determining Movie Creation and Modification Time
     Working With Movie User Data

MOVIE VIEW CLASS
     Movie View Size and Position Functions

MOVIE WINDOW MIXIN CLASSES
     Editing Interface for Movie Window Mixins
     Special modal-dialog call for windows containing movie-views

MOOV SCRAP HANDLER CLASS

FRAME-BASED INTERFACE TO MOVIES
     Converting Between Frames and Times
     Frame-Based Functions For Controlling Movie Playback
     Frame-Based Functions For Movie Posters and Previews
     Frame-Based Functions For Generating QuickDraw Pictures From Movies
     Frame-Based Functions For Editing Movies
     Frame-Based Functions For Low-Level Movie Editing
     Frame-Based Functions For Working With Movie Time

TEST CODE

START QUICKTIME

|#


;;;-----------------------------------------------------------------------------
;;;
;;; SUPPORT FUNCTIONS FROM QUICKDRAW.LISP
;;;
;;;-----------------------------------------------------------------------------

(defmacro with-rectangle-arg ((var left &optional top right bottom) &body body)
  "takes a rectangle, two points, or four coordinates and makes a rectangle.
body is evaluated with VAR bound to that rectangle."
  `(rlet ((,var :rect))
     (setup-rect ,var ,left ,top ,right ,bottom)
     ,@body))

(defun setup-rect (rect left top right bottom)
  (cond (bottom
         (setf (pref rect rect.topleft) (make-point left top))
         (setf (pref rect rect.bottomright) (make-point right bottom)))
        (right
         (error "Illegal rectangle arguments: ~s ~s ~s ~s"
                left top right bottom))
        (top
         (setf (pref rect rect.topleft) (make-point left nil))
         (setf (pref rect rect.bottomright) (make-point top nil)))
        (t (%setf-macptr rect left))))



;;;-----------------------------------------------------------------------------
;;;
;;; MOVIE CLASS
;;;
;;;-----------------------------------------------------------------------------

(defclass movie ()
  ((mptr :initarg :mptr :initform nil :accessor mptr)
   (file :initarg :file :initform nil :accessor file)
   (file-resrefnum :accessor file-resrefnum)
   (resid :accessor resid)
;   (movie-scaling :initform :adjust-view-size :accessor movie-scaling)
   ))

;;; changed by KJ.  When user hits cancel used to get error.  Now if
;;; movie-fsspec-from-user returns NIL, that means user cancelled, so
;;; call (cancel)
(defmethod initialize-instance :after ((my-movie movie) &rest ignore)
  (declare (ignore ignore))
  (rlet ((fsSpec_p :FSSpec))
    (with-slots (mptr file file-resrefnum resid) my-movie
      (unless mptr
        (multiple-value-bind (movie resref movie-resid)
                             (cond ((null file)
                                    (unless (movie-fsspec-from-user fsSpec_p :preview t)
                                      (cancel))
                                    (get-movie-from-fsspec fsSpec_p))
                                   ((probe-file file)
                                    (movie-fsspec-from-path fsSpec_p file)
                                    (get-movie-from-fsspec fsSpec_p))
                                   (t
                                    (new-movie-fsspec fsSpec_p)
                                    (create-movie-file-from-fsspec fsSpec_p)))
          (handle-set-unpurgeable movie)
          (setf mptr movie)
          (setf file (path-from-movie-fsspec fsSpec_p))
          (setf file-resrefnum resref)
          (setf resid movie-resid))))))

;;; for some reason non-handles were being passed in here and causing
;;; an error, so now just by bypass the error message and only let
;;; real handles thru to the code that matters
(defun handle-set-unpurgeable (handle)
  (unless (handlep handle)
    (error "~S is not a valid handle" handle))
  (let (err)
    (#_HNoPurge handle)
    (setq err (#_MemError))
    (unless (zerop err) (error "HNoPurge: ~S -> ~S" handle err))))

(defun handle-set-purgeable (handle)
  ;(unless (handlep handle)
   ; (error "~S is not a valid handle" handle))
  (when (handlep handle)
    (let (err)
      (#_HPurge handle)
      (setq err (#_MemError))
      (unless (zerop err) (error "HPurge: ~S -> ~S" handle err)))))

;;;-----------------------------------------------------------------------------
;;;
;;; ROUTINES FOR GETTING AND PLAYING MOVIES
;;;
;;;-----------------------------------------------------------------------------


;;;-----------------------------------------------------------------------------
;;;
;;; Initializing the System
;;;
;;;-----------------------------------------------------------------------------

(defparameter *movie-update-time-slice* 1000)
;This parameter is measured in QuickTime units

(defparameter *movie-task-interval* 1)
;This parameter is measured in clock ticks

(defparameter *qt-views* nil)
;The idea here is to keep a list of all views with movie objects to make updating more efficient.


;;; Hook

;;; IFT will add methods for this
(defmethod ccl::editing-dialogs-p ((w t))
  nil)

;;; Eventhook
(defun quicktime-eventhook ()
  (dolist (view *qt-views* nil) ;return nil if couldn't handle the event
    (when (view-movie view)
      (if (show-controller-p view)
        (when (and (view-movie-controller view)
                   (not (ccl::editing-dialogs-p view))
                   (not (zerop (#_MCIsPlayerEvent (view-movie-controller view) *current-event*))))
          (return-from quicktime-eventhook t)) ;handled MCIsPlayerEvent, return T
        (#_MoviesTask (slot-value (view-movie view) 'mptr) 0)))))

;;; Initialization
(defvar *qt-initialized?* nil)
(defvar *signal-error-if-no-quicktime* t
  "Whether to signal an error if Quicktime is not installed on startup.")

(defun quicktime-installed? ()
  (rlet ((response :pointer))
    (zerop (#_Gestalt #$gestaltQuickTime response))))

(defun start-quicktime ()
  (unless *qt-initialized?*
    (if (quicktime-installed?)
      (progn
        (#_EnterMovies)
        (push #'quicktime-eventhook *eventhook*)
        (setq *IDLE-SLEEP-TICKS* 0)
        (setf *qt-initialized?* t))
      (when *signal-error-if-no-quicktime*
        (error "QuickTime not installed!")))))

(defun end-quicktime ()
  (when *qt-initialized?*
    (setf *eventhook* (delete 'quicktime-eventhook *eventhook* :key 'function-name))
    (setq *IDLE-SLEEP-TICKS* 5)
    (dolist (mv *qt-views*)
      (dispose-current-movie mv))
;    (#_ExitMovies)
    (setf *qt-initialized?* nil)))

(defun initialize-quicktime ()
  (start-quicktime)
  (unless (member 'start-quicktime *lisp-startup-functions*)
    (setf *lisp-startup-functions*
          (nconc *lisp-startup-functions* (list 'start-quicktime)))
    (pushnew 'end-quicktime *lisp-cleanup-functions*)))


;;;-----------------------------------------------------------------------------
;;;
;;; Error Routines
;;;
;;;-----------------------------------------------------------------------------

(defmacro errcheck-movie (form)
  `(let ((result ,form)
         (error (#_GetMoviesError)))
     (assert (zerop error) () "~&~A had an error: ~A" ',(car form) error)
     result))


;;;-----------------------------------------------------------------------------
;;;
;;; Movie File Routines
;;;
;;;-----------------------------------------------------------------------------

(defmethod open-movie-file ((my-movie movie))
  (with-slots (mptr file file-resrefnum)
              my-movie
    (if file-resrefnum
      file-resrefnum
      (rlet ((fsSpec_p :FSSpec)
             (resRefNum_p :integer))
        (movie-fsspec-from-path fsSpec_p file)
        (#_OpenMovieFile fsSpec_p resRefNum_p #$fsWrPerm)
        (setf file-resrefnum
              (%get-word resRefNum_p))))))

(defun create-movie-file (&optional path)
  (let ((new-movie-filename (or path (new-movie-path))))
    (rlet ((fsSpec_p :FSSpec))
      (movie-fsspec-from-path fsSpec_p new-movie-filename t)
      (create-movie-file-from-fsspec fsSpec_p))))

(defun create-movie-file-from-fsspec (fsSpec_p)
  (rlet ((ResRefNum_p :word)
         (mptr_p :pointer))
    (unless (valid-fsspec-p fsspec_p) (error "Invalid file specification."))
    (errcheck-movie
     (#_CreateMovieFile fsSpec_p #$MovieFileType 0 #$createmoviefileDeleteCurFile resrefnum_p mptr_p))
    (values (%get-ptr mptr_p)
            (%get-signed-word resrefnum_p)
            (rref mptr_p :resourcespec.resid))))

(defun get-movie-from-file (fsSpec-or-path &optional (new-movie-flags #$newMovieActive))
  (if (pathnamep fsSpec-or-path)
    (rlet ((fsSpec_p :FSSpec))
      (movie-fsspec-from-path fsSpec_p (truename fsSpec-or-path))
      (get-movie-from-fsspec fsSpec_p new-movie-flags))
    (get-movie-from-fsspec fsSpec-or-path new-movie-flags)))

(defun get-movie-from-fsspec (fsSpec_p &optional (new-movie-flags #$newMovieActive))
  (rlet ((movieResRefNum_p :word)
         (mptr_p :pointer)
         (actualResId_p :word))
    (unless (fsspec-exists-p fsSpec_p) (error "Not a valid file specification."))
    (errcheck-movie (#_OpenMovieFile fsSpec_p movieResRefNum_p #$fsRdPerm))
    (setf (%get-signed-word actualResId_p) #$DoTheRightThing)
    (errcheck-movie
     (#_NewMovieFromFile mptr_p (%get-signed-word movieResRefnum_p)
      actualResId_p (%null-ptr) new-movie-flags (%null-ptr)))
    (errcheck-movie (#_CloseMovieFile (%get-signed-word movieResRefNum_p)))
    (values (%get-ptr mptr_p)
            (%get-signed-word movieResRefNum_p)
            (%get-signed-word actualResId_p))))

(defun movie-fsspec-from-user (fsSpec_p &key (preview nil))
  "Fill fsSpec_p and return OsError"
  (rlet ((types_p (:array :OSType 1))
         (reply_p :StandardFileReply))
    (%put-ostype types_p :|MooV|)
    (if preview
      (#_StandardGetFilePreview (%null-ptr) 1 types_p reply_p)
      (#_StandardGetFile (%null-ptr) 1 types_p reply_p))
    (when (rref reply_p :StandardFileReply.sfGood)
      (with-pstrs ((filename_p (rref reply_p :StandardFileReply.sfFile.name)))
        (#_FSMakeFSSpec
         (rref reply_p :StandardFileReply.sfFile.vRefNum)
         (rref reply_p :StandardFileReply.sfFile.ParID)
         filename_p fsspec_p)))))

(defun movie-fsspec-from-user-with-preview (fsSpec_p)
  (movie-fsspec-from-user fsSpec_p :preview t))

(defun movie-fsspec-from-path (fsSpec_p path &optional new-file-ok?)
  (with-pstrs ((filename_p (namestring path)))
    (let ((result-code (#_FSmakeFSSpec 0 0 filename_p fsspec_p)))
      (if (or (zerop result-code)
              (and new-file-ok? (= result-code #$fnfErr)))
        fsspec_p
        nil))))

(defun new-movie-fsspec (fsSpec_p)
  (let ((new-movie-filename (new-movie-path)))
    (movie-fsspec-from-path fsSpec_p new-movie-filename t)))

(defmethod close-movie-file ((my-movie movie))
  (with-slots (file-resrefnum) my-movie
    (when file-resrefnum
      (#_CloseMovieFile file-resrefnum)
      (setf file-resrefnum nil))))

(defun new-movie-path ()
  (choose-new-file-dialog
   :prompt "Name for New Movie File..."
   :button-string "Create"))

(defun path-from-movie-fsspec (fsspec)
  (%path-from-fsspec fsspec))

(defun fsspec-exists-p (fsSpec_p)
  "Does the file described by fsSpec_p exist?"
  (rlet ((fndrInfo_p :FInfo))
    (eq 0 (#_FSpGetFInfo fsSpec_p fndrInfo_p))))

(defun valid-fsspec-p (fsSpec_p)
  "Is the fsSpec_p valid.  Note that an fsSpec can be valid
even if the file does not exist"
  (rlet ((fndrInfo_p :FInfo))
    (let ((err (#_FSpGetFInfo fsSpec_p fndrInfo_p)))
      (or (zerop err) (= err #$fnfErr)))))

;;; opens standard choose movie dialog with preview and returns
;;; pathname - useful for when you want to prompt for a movie but just
;;; keep the pathname around

(defun choose-movie-dialog ()
  (rlet ((fsSpec_p :FSSpec))
    (unless (movie-fsspec-from-user fsSpec_p :preview t)
      (cancel))
    (path-from-movie-fsspec fsSpec_p)))

#|
;;; contributed by Peter Stone ([e-mail])
;;; Get movie from resource
;;; I removed some error checking when testing

(defun get-movie-from-resource (id &optional (new-movie-flags #$newMovieActive))
  (let ((movie-fsspec (make-empty-fsspec)))
    (unless movie-fsspec (error "No movie was found"))
    (rlet ((movieResRefNum :word)
           (mptr :pointer)
           (actualResId :word))
       (#_NewMovieFromHandle mptr (load-and-detach-resource "moov" id)
        new-movie-flags (%null-ptr))
       (values (%get-ptr mptr)
              movie-fsspec
              (%get-signed-word movieResRefNum)
              (%get-signed-word actualResId)))))

(defun make-empty-fsspec (&optional new-file-ok?)
  (with-pstrs ((filename (namestring "")))
    (let* ((fsspec (make-record (:fsspec :storage :pointer)))
           (result-code (#_FSmakeFSSpec 0 0 filename fsspec)))
      (if (or (zerop result-code)
           (and new-file-ok? (= result-code #$fnfErr)))
        fsspec
        nil))))

(defun load-and-detach-resource (type id)
  (let* ((res (#_get1resource type id)))
    (#_loadresource res)
    (#_detachresource res)
    res))

(make-instance 'movie-window
    :movie (make-instance 'movie
             :file 1500)) ; integer = moov id

; Add test in initialize-instance:

(defmethod initialize-instance :after ((my-movie movie) &rest ignore)
  (declare (ignore ignore))
  (with-slots (mptr file file-resrefnum resid) my-movie
    (unless mptr
      (multiple-value-bind (movie fsspec resref movie-resid)
                           (cond ((integerp file)
                                  (get-movie-from-resource file))
                                 ((null file)
                                  (get-movie-from-file
                                   (movie-fsspec-from-user-with-preview)))
                                 ((probe-file file)
                                  (get-movie-from-file file))
                                 (t
                                  (create-movie-file file)))
        (setf mptr movie)
        (setf file (path-from-movie-fsspec fsspec))
        (setf file-resrefnum resref)
        (setf resid movie-resid)))))
|#

;;;-----------------------------------------------------------------------------
;;;
;;; Loading and Unloading Movies
;;;
;;;-----------------------------------------------------------------------------

;;; fix by KJ.  Check mptr non-nil before disposing
;;extra fix from JL--make sure that the ptr is a handle before disposing
(defmethod dispose-movie ((my-movie movie))
  (without-interrupts
   (with-slots (mptr) my-movie
     (when (handlep mptr)
       (handle-set-purgeable mptr)
       (#_DisposeMovie mptr))
     (setf mptr nil))))

(defun new-movie (&optional (new-movie-file-flags 1))
  (let ((new-movie (make-instance 'movie
                     :mptr (#_NewMovie new-movie-file-flags))))
    (setf (file-resrefnum new-movie) nil)
    (setf (resid new-movie) nil)
    new-movie))

(defmethod new-movie-from-file ((my-movie movie) &optional (new-movie-flags 1))
  (with-slots (resid file file-resrefnum) my-movie
    (open-movie-file my-movie)
    (rlet ((new-mptr :pointer (mptr (new-movie)))
           (resName :string)
           (resId :word 0)
           (dataRefWasChanged :boolean))
      (#_NewMovieFromFile new-mptr file-resrefnum resId resName new-movie-flags dataRefWasChanged)
      (let ((new-movie (make-instance 'movie
                         :mptr (%get-ptr new-mptr)
                         :file file)))
        (setf (file-resrefnum new-movie) file-resrefnum)
        (setf (resid new-movie) (%get-signed-word resId))
        (close-movie-file my-movie)
        new-movie))))


;;;-----------------------------------------------------------------------------
;;;
;;; Saving Movies
;;;
;;;-----------------------------------------------------------------------------

(defmethod add-movie-resource ((my-movie movie) &optional (fsspec-or-path (new-movie-path))
                               &key (new-resid 0) (new-resname ""))
  (if (pathnamep fsspec-or-path)
    (rlet ((fsSpec_p :FSSpec))
      (movie-fsspec-from-path fsSpec_p fsspec-or-path t)
      (add-movie-resource-to-fsspec my-movie fsSpec_p :new-resid new-resid :new-resname new-resname))
    (add-movie-resource-to-fsspec my-movie fsspec-or-path :new-resid new-resid :new-resname new-resname)))


(defmethod add-movie-resource-to-fsspec ((my-movie movie) fsspec_p
                                         &key (new-resid 0) (new-resname ""))
  (with-slots (mptr resid file-resrefnum)
              my-movie
    (with-pstrs ((resName_p new-resname))
      (rlet ((resrefnum_p :word)
             (resId_p :word new-resid))
        (#_OpenMovieFile fsspec_p resrefnum_p #$fsWrPerm)
        (prog1
          (#_AddMovieResource mptr (%get-word resrefnum_p) resId_p resName_p)
          (when (= (%get-word resrefnum_p) file-resrefnum)
            (setf resid (%get-signed-word resId_p)))
          )))))

(defmethod remove-movie-resource ((my-movie movie) &optional (fsspec-or-path (file my-movie)))
  (if (pathnamep fsspec-or-path)
    (rlet ((fsSpec_p :FSSpec))
      (movie-fsspec-from-path fsSpec_p fsspec-or-path t)
      (remove-movie-resource-from-fsspec my-movie fsSpec_p))
    (remove-movie-resource-from-fsspec my-movie fsspec-or-path)))

(defmethod remove-movie-resource-from-fsspec ((my-movie movie) fsSpec_p)
  (with-slots (resid file-resrefnum file)
              my-movie
    (rlet ((resrefnum_p :word))
      (#_OpenMovieFile fsSpec_p resrefnum_p #$fsWrPerm)
      (prog1
        (#_RemoveMovieResource (%get-word resrefnum_p) resid)
        (when (= (%get-word resrefnum_p) file-resrefnum)
          (setf file nil)
          (setf file-resrefnum nil)
          (setf resid nil))))))

(defmethod update-movie-resource ((my-movie movie) &optional (fsspec-or-path (file my-movie)))
  (if (pathnamep fsspec-or-path)
    (rlet ((fsSpec_p :FSSpec))
      (movie-fsspec-from-path fsSpec_p fsspec-or-path t)
      (update-movie-resource-fsspec my-movie fsSpec_p))
    (update-movie-resource-fsspec my-movie fsspec-or-path)))

(defmethod update-movie-resource-fsspec ((my-movie movie) fsSpec_p)
  (with-slots (mptr resid)
              my-movie
    (rlet ((resrefnum_p :word))
      (#_OpenMovieFile fsSpec_p resrefnum_p #$fsWrPerm)
      (#_UpdateMovieResource mptr (%get-word resrefnum_p) resid (%null-ptr)))))

(defmethod flatten-movie ((my-movie movie) &optional (fsspec-or-path (new-movie-path)))
  (if (pathnamep fsspec-or-path)
    (rlet ((fsSpec_p :FSSpec))
      (movie-fsspec-from-path fsSpec_p fsspec-or-path t)
      (flatten-movie-fsspec my-movie fsSpec_p))
    (flatten-movie-fsspec my-movie fsspec-or-path)))

(defmethod flatten-movie-fsspec ((my-movie movie) fsSpec_p)
  (with-slots (mptr)
              my-movie
    (let ((creator #$MovieFileType)
          (scriptTag #$DoTheRightThing)
          (movieFlattenFlags #$flattenAddMovieToDataFork)
          (createMovieFileFlags #$DoTheRightThing))
      (rlet ((resId_p :word 0)
             (resName_p :string))
        (#_FlattenMovie mptr
         movieFlattenFlags
         fsSpec_p creator scriptTag
         createMovieFileFlags resId_p resName_p)))))

(defmethod save-movie ((my-movie movie) &optional (pathname (file my-movie)))
  (rlet ((fsSpec_p :FSSpec))
    (movie-fsspec-from-path fsSpec_p pathname t)
    (open-movie-file my-movie)
    (update-movie-resource-fsspec my-movie fsSpec_p)
    (flatten-movie-fsspec my-movie fsSpec_p)
    (close-movie-file my-movie)
    (setf (file my-movie) pathname)))

(defmethod has-movie-changed ((my-movie movie))
  (with-slots (mptr) my-movie
    (#_HasMovieChanged mptr)))

(defmethod clear-movie-changed ((my-movie movie))
  (with-slots (mptr) my-movie
    (#_ClearMovieChanged mptr)))


;;;-----------------------------------------------------------------------------
;;;
;;; Controlling Movie Playback
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-active-segment ((my-movie movie))
  (with-slots (mptr) my-movie
    (rlet ((start :long)
           (duration :long))
      (#_getmovieactivesegment mptr start duration)
      (values (%get-long start) (%get-long duration)))))

(defmethod set-movie-active-segment ((my-movie movie)
                                     start-time &optional (duration 0))
  (#_SetMovieActiveSegment (mptr my-movie) start-time duration))

(defmethod get-movie-rate ((my-movie movie))
  (#_GetMovieRate (mptr my-movie)))

(defmethod set-movie-rate ((my-movie movie) factor)
  (with-slots (mptr) my-movie
    (let ((preferred-rate (#_GetMoviePreferredRate mptr)))
      (#_SetMovieRate mptr (* factor preferred-rate)))))

(defmethod go-to-beginning-of-movie ((my-movie movie))
    (#_GoToBeginningofMovie (mptr my-movie)))

(defmethod go-to-end-of-movie ((my-movie movie))
    (#_GoToEndofMovie (mptr my-movie)))

(defmethod start-movie ((my-movie movie))
  (#_StartMovie (mptr my-movie)))

;;; Note: if the movie has a controller attached, and you want the
;;; play/pause button to be updated to reflect the current play state
;;; of the movie, you should use the play-movie and stop-movie methods
;;; that are specialized on the movie-view class instead of the
;;; methods below.

(defmethod stop-movie ((my-movie movie))
  (#_StopMovie (mptr my-movie)))

(defmethod play-movie ((my-movie movie))
  (with-slots (mptr) my-movie
    (#_SetMovieActive mptr t)
    (enhance-movie-playback my-movie :ram-load t)
    (#_StartMovie mptr)))

;;; a synchronous version of play-movie that allows specification of
;;; start and end frames, and will call a function periodically during
;;; movie playback.  Written to maximize playback performance as much
;;; as possible.  Usually used for movie-views with no controller.
;;; The function won't return until the movie is done.
;;; Event processing is locked out and controller will not update itself

(defmethod play-movie* ((movie movie)
                        &key
                        (start-frame 0)
                        (end-frame (get-movie-duration-in-frames movie))
                        play-hook)
  (declare (type integer start-frame end-frame)
           (function is-movie-done (movie) t)
           (function get-movie-frame (movie) integer)
           (inline is-movie-done get-movie-frame)
           (optimize (speed 3) (safety 0)))
  (let ((mptr (slot-value movie 'mptr)))
    (unwind-protect
      (without-interrupts
         (set-movie-frame movie start-frame)
         (play-movie movie)
         (loop
           (cond
            ((is-movie-done movie)
             (stop-movie movie)
             (return))
            ((and end-frame (>= (get-movie-frame movie) end-frame))
             (stop-movie movie)
             (return)))
           (#_MoviesTask mptr #$doTheRIghtThing)
           (when play-hook (funcall play-hook movie))))
      (stop-movie movie))))

(defmethod play-movie-backwards ((my-movie movie))
  (set-movie-rate my-movie -1))

(defmethod fast-forward-movie ((my-movie movie) &optional (new-rate 2))
  (set-movie-rate my-movie new-rate))

(defmethod fast-rewind-movie ((my-movie movie) &optional (new-rate -2))
  (set-movie-rate my-movie new-rate))

(defmethod scan-forward ((my-movie movie))
  (set-movie-rate my-movie 10))

(defmethod scan-reverse ((my-movie movie))
  (set-movie-rate my-movie -10))

(defmethod rewind-movie ((my-movie movie))
  (with-slots (mptr) my-movie
    (#_GoToBeginningOfMovie mptr)
    (#_STOPMOVIE mptr)))

(defmethod wind-to-end-of-movie ((my-movie movie))
  (with-slots (mptr) my-movie
    (#_GotoEndOfMovie mptr)
    (#_STOPMOVIE mptr)))

(defmethod set-play-mode ((m movie) mode)
   (let ((mode-flag (ecase mode
                      (:loop #$loopTimeBase)
                      (:palindrome 2)  ;const not defined apparently
                      (:normal 0))))
     (#_SETTIMEBASEFLAGS (get-movie-time-base m) mode-flag)))

(defmethod get-play-mode ((m movie))
   (case (#_gettimebaseflags (get-movie-time-base m))
     (0 :normal)
     (1 :loop)
     (2 :palindrome)
     (otherwise :unknown)))


;;;-----------------------------------------------------------------------------
;;;
;;; Movie Posters and Previews
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-poster-time ((my-movie movie))
  (#_GetMoviePosterTime (mptr my-movie)))

(defmethod set-movie-poster-time ((my-movie movie) time)
  (#_SetMoviePosterTime (mptr my-movie) time))

(defmethod get-movie-preview-mode ((my-movie movie))
  (#_GetMoviePreviewMode (mptr my-movie)))

(defmethod set-movie-preview-mode ((my-movie movie) use-preview)
  (#_SetMoviePreviewMode (mptr my-movie) use-preview))

(defmethod get-movie-preview-time ((my-movie movie))
  (rlet ((preview-time :timevalue)
         (preview-duration :timevalue))
    (#_SetMoviePreviewTime (mptr my-movie) preview-time preview-duration)
    (values (%get-signed-long preview-time)
            (%get-signed-long preview-duration))))

(defmethod set-movie-preview-time ((my-movie movie) preview-time preview-duration)
  (#_SetMoviePreviewTime (mptr my-movie) preview-time preview-duration))

(defmethod get-poster-box ((my-movie movie))
  (rlet ((poster-box :rect))
    (#_GetPosterBox (mptr my-movie) poster-box)
    (values (rref poster-box :rect.top)
            (rref poster-box :rect.left)
            (rref poster-box :rect.bottom)
            (rref poster-box :rect.right))))

(defmethod set-poster-box ((my-movie movie) left &optional top right bot)
  (with-rectangle-arg (r left top right bot)
    (#_SetPosterBox (mptr my-movie) r)))

(defmethod play-movie-preview ((my-movie movie) &optional (callout-proc nil)
                               (refcon 0))
  (#_PlayMoviePreview (mptr my-movie) (or callout-proc (%null-ptr)) refcon))

(defmethod show-movie-poster ((my-movie movie))
  (with-slots (mptr) my-movie
    (#_SetMovieTimeValue mptr (#_GetMoviePosterTime mptr))
    (#_MoviesTask mptr #$doTHeRIghtThing)))



;;;-----------------------------------------------------------------------------
;;;
;;; Movies and Your Event Loop
;;;
;;;-----------------------------------------------------------------------------


(defmethod is-movie-done ((my-movie movie))
  (#_IsMovieDone (mptr my-movie)))

(defmethod point-in-movie ((my-movie movie) point)
  (#_PtInMovie (mptr my-movie) point))

(defmethod update-movie ((my-movie movie))
  (#_UpdateMovie (mptr my-movie)))



;;;-----------------------------------------------------------------------------
;;;
;;; Preferred Movie Settings
;;;
;;;-----------------------------------------------------------------------------


(defmethod get-movie-preferred-rate ((my-movie movie))
  (#_GetMoviePreferredRate (mptr my-movie)))

(defmethod set-movie-preferred-rate ((my-movie movie) rate)
  (#_SetMoviePreferredRate (mptr my-movie) rate))

(defmethod get-movie-preferred-volume ((my-movie movie))
  (#_GetMoviePreferredVolume (mptr my-movie)))

(defmethod set-movie-preferred-volume ((my-movie movie) volume)
  (#_SetMoviePreferredVolume (mptr my-movie) volume))



;;;-----------------------------------------------------------------------------
;;;
;;; Enhancing Movie Playback Performance
;;;
;;;-----------------------------------------------------------------------------

#|
Movies play better if there is enough Mac Heap allocated to load them into memory.
If you have movie files less than 2 meg in size you might want to allocate
2 meg by calling set-mac-heap-size.  e.g.
(set-mac-heap-size 2000000)
|#

;;; Try to set the mac heap to "size".  Useful so that one can specify the amount
;;; of Mac Heap space is available for loading movies
(defun set-mac-heap-size (size)
    (let (p)
      (when (> size (#_freemem))
        (setq p (#_newptr
                          :d0 size
                          :a0))
        (if (%null-ptr-p p) nil (#_disposptr p)))))

(defmethod get-movie-data-size ((my-movie movie)
                                &optional (starttime 0) (duration (get-movie-duration my-movie)))
  (#_getmoviedatasize (mptr my-movie) starttime duration))

(defmethod can-load-movie-into-ram-p ((my-movie movie))
  (> (#_freemem) (get-movie-data-size my-movie)))

(defconstant keepInRam 1)
(defconstant unkeepInRam 2)

;;; minimum mac heap space needed for movies not in ram to play smoothly.
;;; As a movie is playing it grabs mac heap space.  If there isn't enough it grabs some Lisp
;;; heap space which can be time consuming.
;;; Pick a number, any number :-)
(defvar *min-mac-heap-size* 260000)

(defmethod enhance-movie-playback ((my-movie movie) &key (ram-load t))
  (set-mac-heap-size *min-mac-heap-size*)
  (with-slots (mptr) my-movie
    (let ((preferred-rate (#_GetMoviePreferredRate mptr))
          (movie-time (get-movie-time my-movie)))
      (cond (ram-load
            (when (can-load-movie-into-ram-p my-movie)
              (#_LoadMovieIntoRAM mptr movie-time (get-movie-duration my-movie) keepInRam))
            (#_PrerollMovie Mptr movie-time preferred-rate)) ;preroll not needed for controllers
            (t
             (#_PrerollMovie mptr movie-time preferred-rate))))))

;;;-----------------------------------------------------------------------------
;;;
;;; Disabling Movies
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-active ((my-movie movie))
  (#_getmovieactive (mptr my-movie)))

(defmethod set-movie-active ((my-movie movie) &optional (active t))
  (#_setmovieactive (mptr my-movie) active))


;;;-----------------------------------------------------------------------------
;;;
;;; Generating QuickDraw Pictures From Movies
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-pict ((my-movie movie) time)
  (#_GetMoviePict (mptr my-movie) time))

(defmethod get-movie-poster-pict ((my-movie movie))
  (#_GetMoviePosterPict (mptr my-movie)))

;;; a hint:  Use Mike Engber's oodles-of-utils PICT-SVM class in
;;; conjunction with the above calls to display PICTs from movies
;;; For example:
;;; (make-instance 'pict-svm :pict-handle (get-movie-poster-pict <movie>))

;;; util added by KJ 1/21/93
;;; given a variable name and a filename, creates a temporary movie
;;; object, executes user's forms, then disposes of the movie.

(defmacro with-temp-movie ((var file) &body body)
  (let ((temp (gensym)))
    `(let ((,temp (make-instance 'movie :file ,file)))
       (unwind-protect
         (let ((,var ,temp))
           ,@body)
         (dispose-movie ,temp)))))

#| example using above to display a pict of the movie poster

(oou::oou-dependencies :pict-di)

(with-temp-movie (movie (choose-file-dialog :mac-file-type :|MooV|))
  (make-instance 'dialog
    :window-title "WITH-TEMP-MOVIE Demo"
    :view-subviews (list (make-instance 'pict-di
                           :pict-handle (get-movie-poster-pict movie)))))
|#

;;;-----------------------------------------------------------------------------
;;;
;;; Application-Defined Movie Routines
;;;
;;;-----------------------------------------------------------------------------

(defmethod set-movie-progress-proc ((my-movie movie) proc refcon)
  (#_SetMovieProgressProc (mptr my-movie) proc refcon))

(defmethod set-movie-cover-procs ((my-movie movie) uncover-proc cover-proc refcon)
  (#_SetMovieCoverProcs (mptr my-movie) uncover-proc cover-proc refcon))


;;;-----------------------------------------------------------------------------
;;;
;;; ROUTINES FOR EDITING MOVIES
;;;
;;;-----------------------------------------------------------------------------


;;;-----------------------------------------------------------------------------
;;;
;;; Editing Movies
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-selection ((my-movie movie))
  (with-slots (mptr)
              my-movie
    (rlet ((selectionTime :long)
           (selectionDuration :long))
      (#_GetMovieSelection
       mptr
       selectionTime
       selectionDuration)
      (values (%get-long selectionTime) (%get-long selectionDuration)))))

(defmethod set-movie-selection ((my-movie movie) &optional
                                (start-time 0)
                                (duration (get-movie-duration my-movie)))
  (with-slots (mptr) my-movie
    (#_SetMovieSelection mptr start-time duration)))

(defmethod add-movie-selection ((my-source-movie movie)
                                (my-destination-movie movie))
  (#_AddMovieSelection
   (mptr my-destination-movie)
   (mptr my-source-movie)))

(defmethod clear-movie-selection ((my-movie movie))
  (#_ClearMovieSelection (mptr my-movie)))

(defmethod cut-movie-selection ((my-movie movie))
  (#_CutMovieSelection (mptr my-movie)))

(defmethod copy-movie-selection ((my-movie movie))
  (#_CopyMovieSelection (mptr my-movie)))

(defmethod paste-movie-selection ((my-source-movie movie)
                                  (my-destination-movie movie))
  (let ((movie-containing-selection
         (#_copymovieselection (mptr my-source-movie))))
    (#_PasteMovieSelection
     (mptr my-destination-movie) movie-containing-selection)
    (#_disposemovie movie-containing-selection)))

(defmethod paste-specified-selection ((source-movie movie)
                                      source-start-time
                                      source-duration
                                      (destination-movie movie))
  (set-movie-selection source-movie
                       source-start-time
                       source-duration)
  (paste-movie-selection source-movie
                         destination-movie))


;;;-----------------------------------------------------------------------------
;;;
;;; Low-Level Movie Editing Routines
;;;
;;;-----------------------------------------------------------------------------


(defmethod copy-movie-settings ((my-source-movie movie)
                                (my-destination-movie movie))
  (#_CopyMovieSettings
   (mptr my-source-movie)
   (mptr my-destination-movie)))

(defmethod delete-movie-segment ((my-movie movie) start-time duration)
  (with-slots (mptr) my-movie
    (#_DeleteMovieSegment mptr start-time duration)))


(defmethod insert-empty-movie-segment ((my-movie movie) start-time duration)
  "Inserts empty space into a movie -- but cannot do this at the end of a movie"
  (with-slots (mptr) my-movie
    (#_InsertEmptyMovieSegment mptr start-time duration)))

(defmethod insert-movie-segment ((my-source-movie movie) (my-destination-movie movie)
                                 &key
                                 source-movie-segment-start-time
                                 source-movie-segment-duration
                                 destination-movie-insert-start-time)
  (#_InsertMovieSegment
   (mptr my-source-movie)
   (mptr my-destination-movie)
   source-movie-segment-start-time
   source-movie-segment-duration
   destination-movie-insert-start-time))

(defmethod scale-movie-segment ((my-movie movie) start-time old-duration new-duration)
  (with-slots (mptr) my-movie
    (#_ScaleMovieSegment mptr start-time old-duration new-duration)))


;;;-----------------------------------------------------------------------------
;;;
;;; ROUTINES THAT MODIFY MOVIE PROPERTIES
;;;
;;;-----------------------------------------------------------------------------


;;;-----------------------------------------------------------------------------
;;;
;;; Working With Movie Spatial Characteristics
;;;
;;;-----------------------------------------------------------------------------

;;; returns 4 values: left, top, right, bottom of movie box
(defmethod get-movie-box ((my-movie movie))
  (with-slots (mptr) my-movie
    (rlet ((movieBounds :rect))
      (#_GetMovieBox mptr movieBounds)
      (values (rref movieBounds :rect.left)
              (rref movieBounds :rect.top)
              (rref movieBounds :rect.right)
              (rref movieBounds :rect.bottom)))))

(defmethod set-movie-box ((my-movie movie) left &optional top right bottom)
  (with-rectangle-arg (r left top right bottom)
    (#_SetMovieBox (mptr my-movie) r)))

;;; returns a point specifying width and height of movie box
(defmethod movie-size ((my-movie movie))
  (multiple-value-bind (left top right bottom) (get-movie-box my-movie)
    (let  ((rectwidth (- right left))
           (rectheight (- bottom top)))
      (make-point rectwidth rectheight))))


;;;-----------------------------------------------------------------------------
;;;
;;; Working With Sound Volume
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-volume ((my-movie movie))
  (#_GetMovieVolume (mptr my-movie)))

(defmethod set-movie-volume ((my-movie movie) volume)
  (#_SetMovieVolume (mptr my-movie) volume))


;;;-----------------------------------------------------------------------------
;;;
;;; Working With Movie Time
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-duration ((my-movie movie))
  (#_GetMovieDuration (mptr my-movie)))

(defmethod get-movie-time ((my-movie movie) &optional time-record)
  (#_GetMovieTime (mptr my-movie) (or time-record (%null-ptr))))

(defmethod set-movie-time ((my-movie movie) time &optional time-scale)
  (let* ((time-scale (if time-scale time-scale (get-movie-time-scale my-movie)))
         (time-record (create-time-record time time-scale)))
    (#_SetMovieTime (mptr my-movie) time-record)))

(defmethod get-movie-time-base ((my-movie movie))
  (#_GetMovieTimeBase (mptr my-movie)))

(defmethod get-movie-time-scale ((my-movie movie))
  (#_GetMovieTimeScale (mptr my-movie)))

(defmethod set-movie-time-scale ((my-movie movie) time-scale)
  (#_SetMovieTimeScale (mptr my-movie) time-scale))

(defmethod set-movie-time-value ((my-movie movie) time)
  (#_SetMovieTimeValue (mptr my-movie) time))


;;;-----------------------------------------------------------------------------
;;;
;;; Determining Movie Creation and Modification Time
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-creation-time ((my-movie movie))
  (#_GetMovieCreationTime (mptr my-movie)))

(defmethod get-movie-modification-time ((my-movie movie))
  (#_GetMovieModificationTime (mptr my-movie)))


;;;-----------------------------------------------------------------------------
;;;
;;; Working With Movie User Data
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-user-data ((my-movie movie))
  (#_GetMovieUserData (mptr my-movie)))





;;;-----------------------------------------------------------------------------
;;;
;;; MOVIE VIEW CLASS
;;;
;;;-----------------------------------------------------------------------------

(defclass movie-view (simple-view)
  ((movie :initarg :movie :initform nil :accessor view-movie)
   (show-controller :initarg :show-controller :accessor show-controller-p)
   (enable-editing :initarg :enable-editing :accessor enable-editing-p)
   (controller :initform nil :accessor view-movie-controller))
  (:default-initargs :show-controller t :enable-editing nil))

;;; check for quicktime before getting into trouble

(defmethod initialize-instance :around ((mv movie-view) &rest initargs)
  (declare (ignore initargs))
  (if (and *qt-initialized?* (quicktime-installed?))
    (call-next-method)
    (error "QuickTime is not available.  Make sure QuickTime is installed and (initialize-quicktime) has been evaluated.")))

(defmethod initialize-instance :after ((mv movie-view) &rest ignore)
  (declare (ignore ignore))
  (when (view-movie mv)         ;;JL--only update if there is a movie present
    (update-for-new-movie mv)))

#| old
(defmethod view-default-size ((mv movie-view))
  (with-slots (movie) mv
    (cond
     (movie (movie-size movie))
     (t #@(160 120))))) ;; this should perhaps change to 320x240
|#

(defparameter *controller-height* 16)
(defmethod view-default-size ((mv movie-view))
  (with-slots (movie) mv
    (cond
     ((and movie (show-controller-p mv))
      (add-points (movie-size movie) (make-point 0 *controller-height*)))
     (movie (movie-size movie))
     (t #@(160 120))))) ;; this should perhaps change to 320x240

;;; Get a movie
;;; can supply a pathname, a movie instance, or NIL for an "empty"
;;; movie view
;;; with modifications to allow a pathname to a file on the working volume only
#|

 Bug report - why without-interrupts is needed

Well, apparently when I set the view-movie from my app (not from the
listener) somehow the event manager decides to issue update events between
when the view-movie slot is set and when it is initialized. Thus, it tries
to view-draw-contents and dies because the mptr is nil. I don't know why it
should choose that time, consistently, to do it's redrawing, exactly, but
this without-interrupts fixed the problem. Go figure.
|#

(defmethod (setf view-movie) (pathname (view movie-view))
  (let ((log-path (if pathname (translate-logical-pathname pathname))))
    (unless (probe-file log-path)
      (error "~&Can't find file ~S" log-path))
    (without-interrupts
     (when (view-movie view)
       (dispose-current-movie view))
     (setf (slot-value view 'movie)
           (make-instance 'movie :file log-path))
     (when (wptr view)
       (initialize-movie-view view))
     (update-for-new-movie view))
    (slot-value view 'movie)))

(defmethod (setf view-movie) ((movie movie) (view movie-view))
  (without-interrupts
   (when (view-movie view)
     (dispose-current-movie view))
   (setf (slot-value view 'movie) movie)
   (when (wptr view)
     (initialize-movie-view view))
   (update-for-new-movie view))
  movie)

;; JL--if the pathname is nil, then just set the view-movie slot to
;; nil and erase the view

(defmethod (setf view-movie) ((movie null) (view movie-view))
  (without-interrupts
   (when (view-movie view)
     (dispose-current-movie view))
   (setf (slot-value view 'movie) nil)
   (invalidate-view view t))
  nil)

;;; dont want to clobber movie object since may want to reinstall view
;;; at some point and want to keep around filename
;;;without-interrupts keeps redraw events or movie-updates
;;;from using a disposed mptr -JL

(defmethod dispose-current-movie ((mv movie-view))
  (with-slots (movie controller) mv
    (without-interrupts
     (when controller
       (#_DisposeMovieController controller)
       (setq controller nil))
     (when movie
       (dispose-movie movie)
       (setf movie nil)))))

;;; when no controller present, handle clicks on the movie as the
;;; controller does: double-click to start, single click to stop playing
(defmethod view-click-event-handler ((view movie-view) where)
  (declare (ignore where))
  (unless (view-movie-controller view)
    (with-slots (movie) view
      (when movie
        (cond
         ((double-click-p)
          (when (is-movie-done movie) (rewind-movie movie))
          (play-movie movie))
         (t (stop-movie movie)))))))


;;;-----------------------------------------------------------------------------
;;;
;;; Movie View Size and Position Functions
;;;
;;;-----------------------------------------------------------------------------

;;; ----------- Thanks to Bill St. Clair for much of this
;;; To ensure that the movie gets moved when one of its ancestor views gets moved or removed.
;;; Each view keeps track of any movie-views contained within it in *movie-view-table*
(defvar *movie-view-table* (make-hash-table :test 'eq))

;;; Remove views from *movie-view-table* when a view or window is deleted.
;;; Replacement for weak hash tables below. -neves
(defmethod remove-view-from-window :before ((view movie-view))
  (map-view-ancestors view
                      #'(lambda (ancestor)
                          (delete-movie-view-ancestor view ancestor))))

(defun ancestor-movie-views (ancestor)
  (gethash ancestor *movie-view-table*))

(defun add-movie-view-ancestor (view ancestor)
  (pushnew view (gethash ancestor *movie-view-table*)))

(defun delete-movie-view-ancestor (view ancestor)
  (let ((views (delete view (gethash ancestor *movie-view-table*))))
    (if views
      (setf (gethash ancestor *movie-view-table*) views)
      (remhash ancestor *movie-view-table*))))

(defun map-view-ancestors (view function)
  (let ((ancestor view))
    (loop
      (setq ancestor (view-container ancestor))
      (unless ancestor (return))
      (funcall function ancestor))))

;in case set-view-container is used to move a tree of views.  set-view-container calls
;remove-view-from-window so all the hash table information is destroyed.  These four methods
;will rebuild it.
(defmethod add-child-movie-views ((view movie-view))
  (map-view-ancestors view #'(lambda (ancestor)
                                 (add-movie-view-ancestor view ancestor))))
(defmethod add-child-movie-views ((view view))
  (dovector (v (view-subviews view)) (add-child-movie-views v)))
(defmethod add-child-movie-views ((view simple-view)))
(defmethod set-view-container :after ((view view) parent)
  (declare (ignore parent))
  (add-child-movie-views view)
  )

(defmethod set-view-container :before ((view view) parent)
  (declare (ignore parent))
  (dolist (movie-view (gethash view *movie-view-table*))
    (map-view-ancestors view #'(lambda (ancestor)
                                 (delete-movie-view-ancestor movie-view ancestor)))))

(defmethod set-view-container :before ((view movie-view) parent)
  (declare (ignore parent))
  (map-view-ancestors view
                 #'(lambda (ancestor)
                     (delete-movie-view-ancestor view ancestor))))

(defmethod set-view-container :after ((view movie-view) parent)
  (declare (ignore parent))
  (map-view-ancestors view #'(lambda (ancestor)
                          (add-movie-view-ancestor view ancestor))))

(defmethod set-view-position :after (view h &optional v)
  (declare (ignore h v))
  (dolist (movie-view (ancestor-movie-views view))
    (set-movie-to-view movie-view)))
;;; ----------- end of Bill's code

(defmethod set-view-position :after ((mv movie-view) h &optional v)
  (declare (ignore h v))
  (set-movie-to-view mv))

(defmethod set-view-size :after ((mv movie-view) h &optional v)
  (declare (ignore h v))
  (set-movie-to-view mv))

(defmethod set-movie-box ((movie movie) left &optional top right bot)
  (with-rectangle-arg (r left top right bot)
    (#_SetMovieBox (mptr movie) r)))

(defmethod set-controller-box ((movie-view movie-view) left &optional top right bot)
  (with-rectangle-arg (r left top right bot)
    (#_MCSetControllerBoundsRect (view-movie-controller movie-view) r)))

;;; returns 4 values: top, left, bottom, right of movie box
(defmethod movie-box ((m movie))
  (with-slots (mptr) m
    (rlet ((movieBounds :rect))
      (#_GetMovieBox mptr movieBounds)
      (values (rref movieBounds :rect.top) (rref movieBounds :rect.left)
              (rref movieBounds :rect.bottom) (rref movieBounds :rect.right)))))

;;; returns a point specifying width and height of movie box
(defmethod movie-size ((m movie))
  (multiple-value-bind (top left bottom right) (movie-box m)
    (let  ((rectwidth (- right left))
           (rectheight (- bottom top)))
      (make-point rectwidth rectheight))))

(defmethod view-activate-event-handler :after ((mv movie-view))
  (when (view-movie mv)     ;;;;JL-- only activate if there is a movie in residence
    (#_SetMovieActive (slot-value (view-movie mv) 'mptr) t)
    (enhance-movie-playback (view-movie mv) :ram-load t)
    (when (view-movie-controller mv)
      (#_MCActivate (view-movie-controller mv)
       (wptr (view-window mv)) t))))

(defmethod view-deactivate-event-handler :after ((mv movie-view))
  ;; this will turn off background movie showing. uncomment if this is desired
  ;(#_SetMovieActive (slot-value (view-movie mv) 'mptr) nil)
  (when (view-movie-controller mv)
    (#_MCActivate (view-movie-controller mv)
     (wptr (view-window mv)) nil)))

(defmethod show-controller ((mv movie-view))
  (when (view-movie-controller mv)
    (#_MCSetVisible (view-movie-controller mv) t)))

(defmethod hide-controller ((mv movie-view))
  (when (view-movie-controller mv)
    (#_MCSetVisible (view-movie-controller mv) nil)))

(defmethod controller-visible-p ((mv movie-view))
  (when (view-movie-controller mv)
    (not (zerop (#_MCGetVisible (view-movie-controller mv))))))

;;;JL 5/12 -- check to make sure the mptr is a valid handle
;;;sometimes recently disposed movies are still being drawn.
;;;this causes a crash.
(defmethod view-draw-contents :after ((movie-view movie-view))
  (with-slots (movie) movie-view
    (without-interrupts
     (when (and movie (handlep (mptr movie)))
       (with-focused-view (view-window movie-view)
         (#_SetMovieActive (slot-value movie 'mptr) t)
         (#_Updatemovie (slot-value movie 'mptr))
         (when (view-movie-controller movie-view)
           (#_MCDraw (view-movie-controller movie-view)
            (wptr (view-window movie-view)))))))))

(defmethod remove-view-from-window ((mv movie-view))
  (without-interrupts
   (dispose-current-movie mv)
   (setq *qt-views* (remove mv *qt-views*)))
  (call-next-method))

;;; reinstall movie if filename exists but mptr is null
;;; this should support remove-subviews and then readding them later on.
(defmethod install-view-in-window :after ((mv movie-view) (win window))
  (initialize-movie-view mv)
  )

(defmethod initialize-movie-view ((mv movie-view))
  (when (view-movie mv)
    (with-slots (mptr file) (view-movie mv)
      (when (and file (null mptr))
        (multiple-value-bind (movie)
                             (get-movie-from-file file)
          (setf mptr movie))
        (update-for-new-movie mv))
      (when (and file mptr)  ;;;JL -- if the view already has a valid movie in it,
        (update-for-new-movie mv)))      ;;;then update right away
  (pushnew mv *qt-views*)))


(defmethod update-for-new-movie ((view movie-view))
  (when (wptr view)
    (with-slots (movie) view
      (let ((mptr (slot-value movie 'mptr)))
        (without-interrupts
         (with-focused-view view
           (errcheck-movie (#_SetMovieGWorld mptr (%null-ptr) (%null-ptr)))
           (when (and (show-controller-p view) (null (view-movie-controller view)))
             (with-rectangle-arg (r 0 (view-size view))
               (setf (view-movie-controller view)
                     (errcheck-movie (#_NewMovieController mptr r
                                      (controller-creation-flags-value)))) ;#$mcTopLeftMovie
               (when (enable-editing-p view)
                 (#_MCEnableEditing (view-movie-controller view) t))
               ))) ;end with-focused-view
         (set-movie-to-view view)
         (invalidate-view view)
         (#_StopMovie mptr)
         (#_GoToBeginningOfMovie mptr)
         (with-focused-view (view-window view)
           (#_UpdateMovie mptr)) ;MK
         (#_MoviesTask mptr #$doTHeRIghtThing))))))

(defparameter *controller-creation-flags* (list #$mcTopLeftMovie))

(defun controller-creation-flags-value ()
  (let ((result 0))
    (dolist (flag *controller-creation-flags* result)
      (setq result (boole boole-ior result flag)))))

;;; move the movie controller to the specified location
;;; the trick to doing this is to unattach the movie controller,
;;; however once this is done you must update the movie box manually
;;; when changing sizes

(defmethod position-controller ((mv movie-view) top left bottom right)
  (with-slots (movie controller) mv
    (#_MCSetcontrollerAttached controller nil)
    (rlet ((movieBounds :rect)
           (mcBounds :rect
                     :top top
                     :left left
                     :bottom bottom
                     :right right))
      (#_GetMovieBox (slot-value movie 'mptr) movieBounds)
      (#_MCPositionController controller moviebounds mcbounds #$mcWithFrame))))

;;; if you want the play/pause button on the controller to reflect real play state of
;;; movie you need to use the following two methods instead of calling
;;; the same methods directly on the movie object (so we can access
;;; the controller)
;;; these no longer seem to be working in QT 1.6 - don't know why

(defmethod play-movie ((movie-view movie-view))
  (play-movie (view-movie movie-view))
  (when (view-movie-controller movie-view)
    (#_McDoAction (view-movie-controller movie-view)
     #$mcActionPlay (%null-ptr))))

(defmethod stop-movie ((movie-view movie-view))
  (#_StopMovie (mptr (view-movie movie-view)))
  (when (view-movie-controller movie-view)
    (#_McDoAction (view-movie-controller movie-view)
     #$mcActionPlay (%null-ptr))))

;;;-----------------------------------------------------------------------------
;;;
;;; MOVIE WINDOW MIXIN CLASSES
;;;
;;;-----------------------------------------------------------------------------

;;; this is necessary because windoid defines a view-default-size method.
;;; hide window until after initialize-instance to hide ugly intermediate
;;; drawing stages
(defclass movie-window-mixin ()
  ((last-edit :initform nil :accessor last-edit))
  (:default-initargs :enable-editing t :window-show nil))

(defmethod initialize-instance :after ((mw movie-window-mixin) &rest ignore)
  (declare (ignore ignore))
  (when (and (string-equal (window-title mw) "Untitled")
             (view-movie mw))
    (set-window-title mw (pathname-name (file (view-movie mw)))))
  (initialize-movie-view mw)
  (window-select mw))

;;; for some reason the controller and the grow-icon don't line up
;;; it appears that the MCL grow icon is one pixel lower than the one
;;; in Movie Player window's.  Make default to no grow-icon - you can
;;; have one if you want by specifying the initarg.

(defclass movie-window (movie-window-mixin movie-view window) ()
  (:default-initargs :grow-icon-p nil))

(defclass movie-windoid (movie-window-mixin movie-view windoid) ())

(defmethod find-movie-windoid ((movie movie))
  (find movie (windows :class 'movie-windoid :include-windoids t)
        :key #'(lambda (x)
                 (let ((mdi (car (subviews x 'movie-dialog-item))))
                   (when mdi (slot-value mdi 'movie))))))

(defclass movie-dialog-item (movie-view dialog-item) ()
  (:default-initargs
    :dialog-item-action #'(lambda (mdi)
                            (let ((movie (slot-value mdi 'movie)))
                              (if (command-key-p)
                                (print (slot-value movie 'file))
                                (cond ((is-movie-done movie)
                                       (rewind-movie movie)
                                       (play-movie movie))
                                      ((and (not (zerop (get-movie-rate movie)))
                                            (get-movie-active movie)
                                            (not (is-movie-done movie)))
                                       (stop-movie movie))
                                      (t
                                       (play-movie movie))))))))

(defun standard-position (window-type)
  (cond ((equal window-type 'movie-windoid)
         #@(100 100))
        (t
         #@(40 40))))

(defmethod stagger-windows (window-type)
  (let ((current-windows (windows :class window-type :include-windoids t)))
    (if current-windows
      (add-points (standard-position window-type)
                  (make-point (* (length current-windows)
                                 15)
                              (* (length current-windows)
                                 15)))
      (standard-position window-type))))

(defmethod set-movie-to-view ((mv movie-view))
  (when (view-movie mv)
;    (if (eq (movie-scaling mv) :adjust-view-size)
      (let* ((topleft (subtract-points #@(0 0) (view-origin mv)))
             (bottomright (add-points topleft (view-size mv))))
        (when (< (max (abs (point-h topleft)) (abs (point-v topleft) )
                           (abs (point-h bottomright)) (abs (point-v bottomright))) 30000)
          (if (view-movie-controller mv)
            (set-controller-box mv topleft bottomright)
            (set-movie-box (view-movie mv) topleft bottomright))))))
;  )

;;; a specialized version for movie windows with grow boxes and
;;; controllers- makes sure the grow box isn't clobbered
(defmethod set-movie-to-view ((mw movie-window))
  (cond
   ;; grow box, movie, and controller?
   ((and (ccl::window-grow-icon-p mw)
         (view-movie mw)
         (view-movie-controller mw))
    (position-controller
     mw
     (rref (ccl::grow-icon-rect mw) :rect.top)
     0 ;left
     (rref (ccl::grow-icon-rect mw) :rect.bottom)
     (rref (ccl::grow-icon-rect mw) :rect.left))
    (let* ((topleft (subtract-points #@(0 0) (view-origin mw)))
           (bottomright (make-point (point-h (view-size mw))
                                    (1- (rref (ccl::grow-icon-rect mw) :rect.top)))))
      (set-movie-box (view-movie mw) topleft bottomright)))
   ;; otherwise use the standard method for movie views
   (t (call-next-method))))

;;; this sometimes doesn't draw the controller when zooming up although
;;; it does draw it when zooming back to normal size.  Why?
(defmethod window-zoom-event-handler :after ((mw movie-window) message)
  (declare (ignore message))
  (set-movie-to-view mw))

;;;-----------------------------------------------------------------------------
;;;
;;; Editing Interface for Movie Window Mixins
;;;
;;;-----------------------------------------------------------------------------

;;; Window methods for cutting/pasting.  I'm not sure how to do this if there
;;; are multiple movie-views in a window, hence these methods are defined only
;;; for movie-windows.

(defmethod copy ((w movie-window-mixin))
  (when (view-movie-controller w)
    (put-scrap :|moov| (#_MCCopy (view-movie-controller w)))))

(defmethod paste ((w movie-window-mixin))
  (when (view-movie-controller w)
    (#_MCPaste (view-movie-controller w) (get-scrap :|moov|))
    (setf (last-edit w) 'paste)))

(defmethod cut ((w movie-window-mixin))
  (when (view-movie-controller w)
    (put-scrap :|moov| (#_MCCut (view-movie-controller w)))
    (setf (last-edit w) 'cut)))

(defmethod undo ((w movie-window-mixin))
  (when (view-movie-controller w)
    (#_MCUndo (view-movie-controller w))
    (setf (last-edit w) 'undo)))

(defmethod clear ((w movie-window-mixin))
  (when (view-movie-controller w)
    (#_MCClear (view-movie-controller w))
    (setf (last-edit w) 'clear)))

(defmethod select-all ((w movie-window-mixin))
  (when (view-movie-controller w)
    (set-movie-selection (view-movie w))
    (#_MCDraw (view-movie-controller w) (wptr w))))

(defmethod window-can-do-operation ((w movie-window-mixin) operation &optional menu-item)
  (declare (ignore menu-item))
  (and (view-movie-controller w)
       (#_MCIsEditingEnabled (view-movie-controller w))
       (case operation
         (paste (get-scrap :|moov|))
         ((cut copy clear)
          (multiple-value-bind (start dur) (get-movie-selection (view-movie w))
            (declare (ignore start))
            (not (zerop dur))))
         (undo (when (and (last-edit w) (member (last-edit w) '(paste cut undo clear)))
                 (set-menu-item-title (first (menu-items *edit-menu*))
                                      (format nil "Undo ~:(~A~)" (last-edit w)))
                 t))
         (select-all t)
         (t nil))))

;;; Saving movies

(defmethod window-save ((mw movie-window))
  (save-movie (view-movie mw)))

(defmethod window-save-as ((mw movie-window))
  (let* ((old-filename (file (view-movie mw)))
         (new-filename (choose-new-file-dialog
                        :directory old-filename
                        :prompt "Save Movie AsÉ")))
    (save-movie (view-movie mw) new-filename)
    (set-window-title mw (pathname-name new-filename))))

;;; QT MODAL DIALOG

;;; special modal-dialog call that adds quicktime eventhook to the
;;; modal dialog call so that the controller can be updated properly
;;; not necessary to use this unless a modal dialog contains a qt-view
;;; with a controller.

(defmethod qt-modal-dialog ((dialog window) &optional (close-on-exit t)
                            (eventhook 'quicktime-eventhook))
  (cond
   ;; if a list is supplied, make sure it contains eventhook, else add it
   ((and (consp eventhook)
         (not (member 'quicktime-eventhook eventhook
                      :key #'(lambda (item) (or (function-name item) item)))))
    (push 'quicktime-eventhook eventhook))
   ;; if an atom is supplied and its not the quicktime-eventhook,
   ;; create a list that contains the quicktime-eventhook and the
   ;; supplied eventhook
   ((and (atom eventhook)
         (neq eventhook 'quicktime-eventhook))
    (setq eventhook (list 'quicktime-eventhook eventhook))))
  (modal-dialog dialog close-on-exit eventhook))


;;;-----------------------------------------------------------------------------
;;;
;;; MOOV SCRAP HANDLER CLASS
;;;
;;;-----------------------------------------------------------------------------

(defclass moov-scrap-handler (scrap-handler) ())

(defmethod set-internal-scrap ((self moov-scrap-handler) scrap)
  (call-next-method self scrap)
  (when scrap (pushnew :|moov| *scrap-state*)))

(defmethod externalize-scrap ((h moov-scrap-handler))
  (let* ((moov (slot-value h 'ccl::internal-scrap)))
    (when moov
      (#_PutMovieOnScrap moov 0))))

(defmethod internalize-scrap ((h moov-scrap-handler))
  (let* ((moov (#_NewMovieFromScrap 0)))
    (setf (slot-value h 'ccl::internal-scrap) moov)))

(defmethod get-internal-scrap ((h moov-scrap-handler))
  (slot-value h 'ccl::internal-scrap))

(pushnew `(:|moov| . ,(make-instance 'moov-scrap-handler))
         *scrap-handler-alist*
         :test #'equal)





;;;-----------------------------------------------------------------------------
;;;
;;; FRAME-BASED INTERFACE TO MOVIES
;;;
;;;-----------------------------------------------------------------------------



;;;-----------------------------------------------------------------------------
;;;
;;; Converting Between Frames and Times
;;;
;;;-----------------------------------------------------------------------------

;;;Conversions between *frames-per-second*, time, time-scale, and current-frame

;;; current-frame       =  (floor (/ (* time *frames-per-second*) time-scale))
;;; time                =  (floor (* current-frame time-scale) *frames-per-second*)
;;; time-scale          =  (floor (/ time (floor (/ current-frame *frames-per-second*))))
;;; *frames-per-second* =  (floor (/ time (* current-frame time-scale)))

;To simulate dealing with video set *frames-per-second* to 30
;To simulate dealing with film set *frames-per-second* to 24

(defvar *frames-per-second* 30)

(defun create-time-record (time time-scale)
  (make-record :TIMERECORD
               :VALUE.HI (num-to-hi64 time)
               :VALUE.LO (num-to-lo64 time)
               :SCALE time-scale
               :BASE (#_NewTimeBase)))

(defun num-to-hi64 (num)
  (floor num 4294967296))

(defun num-to-lo64 (num)
  (logand num 4294967295))

(defmethod frame-to-time ((my-movie movie) frame &key (frames-per-second *frames-per-second*))
  (floor (* frame (get-movie-time-scale my-movie)) frames-per-second))

(defmethod time-to-frame ((my-movie movie) time &key (frames-per-second *frames-per-second*))
  (floor (/ (* time frames-per-second) (get-movie-time-scale my-movie))))

;;; this returns a string in H:MM:SS.FF format (H=hours, M=mins, S=secs, F=frames 0-29)
;;; it can also be used to calculate the duration of a selection.  just pass in results of
;;; get-movie-selection-in-frames and it return how long the selection is.

(defmethod frame-to-smpte-time-string ((m movie) frame &key (frames-per-second *frames-per-second*))
  (let* ((time (frame-to-time m frame :frames-per-second frames-per-second))
         (time-scale (get-movie-time-scale m))
         (seconds (/ time time-scale))
         (secs+remainder (multiple-value-list (floor seconds)))
         (frames (time-to-frame m (* (second secs+remainder) time-scale)
                                :frames-per-second frames-per-second))
         (second (mod (car secs+remainder) 60))
         (minute (mod (floor seconds 60) 60))
         (hour (floor seconds 3600)))
    (format nil "~D:~2,'0D:~2,'0D.~2,'0D" hour minute second frames)))


;;;-----------------------------------------------------------------------------
;;;
;;; Frame-Based Functions For Controlling Movie Playback
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-active-segment-in-frames ((my-movie movie) &key (frames-per-second *frames-per-second*))
  (multiple-value-bind (start-time duration)
                       (get-movie-active-segment my-movie)
    (let* ((start-frame (time-to-frame my-movie start-time :frames-per-second frames-per-second))
           (end-frame (+ start-frame (time-to-frame duration my-movie :frames-per-second frames-per-second))))
      (values start-frame end-frame))))

(defmethod set-movie-active-segment-in-frames ((my-movie movie) start-frame end-frame &key (frames-per-second *frames-per-second*))
  (let* ((start-time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (set-movie-active-segment my-movie start-time duration)))

(defmethod frame-forward-movie ((movie movie) &optional (increment 1) &key (frames-per-second *frames-per-second*))
  (with-slots (mptr) movie
    (let* ((time-scale (#_GetMovieTimeScale mptr))
           (time 0)
           (time-record (create-time-record time time-scale)))
      (#_GetMovieTime mptr time-record)
      (let ((new-time (+ (rref time-record :timerecord.value.lo)
                         (* increment (/ time-scale frames-per-second)))))
        (rset time-record :timerecord.value.lo new-time)
        (#_SetMovieTime mptr time-record)
        (dispose-record time-record)
        new-time))))

(defmethod frame-reverse-movie ((movie movie) &optional (increment -1) &key (frames-per-second *frames-per-second*))
  (frame-forward-movie movie increment :frames-per-second frames-per-second))


;;;-----------------------------------------------------------------------------
;;;
;;;  Frame-Based Functions For Movie Posters and Previews
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-poster-time-in-frames ((my-movie movie) &key (frames-per-second *frames-per-second*))
  (time-to-frame my-movie (get-movie-poster-time my-movie) :frames-per-second frames-per-second))

(defmethod set-movie-poster-time-in-frames ((my-movie movie) frame &key (frames-per-second *frames-per-second*))
  (set-movie-poster-time my-movie (frame-to-time my-movie frame :frames-per-second frames-per-second)))

(defmethod get-movie-preview-time-in-frames ((my-movie movie) &key (frames-per-second *frames-per-second*))
  (multiple-value-bind (preview-time preview-duration)
                       (get-movie-preview-time my-movie)
    (let* ((start-frame (time-to-frame my-movie preview-time :frames-per-second frames-per-second))
           (end-frame (+ start-frame (time-to-frame my-movie preview-duration :frames-per-second frames-per-second))))
      (values start-frame end-frame))))

(defmethod set-movie-preview-time-in-frames ((my-movie movie) start-frame end-frame &key (frames-per-second *frames-per-second*))
  (let* ((preview-time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (preview-duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (set-movie-preview-time my-movie preview-time preview-duration)))


;;;-----------------------------------------------------------------------------
;;;
;;; Frame-Based Functions For Generating QuickDraw Pictures From Movies
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-pict-in-frames ((my-movie movie) frame &key (frames-per-second *frames-per-second*))
  (get-movie-pict my-movie (frame-to-time my-movie frame :frames-per-second frames-per-second)))


;;;-----------------------------------------------------------------------------
;;;
;;; Frame-Based Functions For Editing Movies
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-selection-in-frames ((my-movie movie) &key (frames-per-second *frames-per-second*))
  (multiple-value-bind (start-time duration)
                       (get-movie-selection my-movie)
    (let* ((start-frame (time-to-frame my-movie start-time :frames-per-second frames-per-second))
           (end-frame (+ start-frame (time-to-frame my-movie duration :frames-per-second frames-per-second))))
      (values start-frame end-frame))))

(defmethod set-movie-selection-in-frames ((my-movie movie)
                                          start-frame
                                          end-frame
                                          &key (frames-per-second *frames-per-second*))
  (let* ((start-time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (set-movie-selection my-movie start-time duration)))


(defmethod paste-specified-selection-in-frames ((source-movie movie)
                                                source-start-frame
                                                source-end-frame
                                                (destination-movie movie)
                                                &key (frames-per-second *frames-per-second*))
  (set-movie-selection-in-frames source-movie
                                 source-start-frame
                                 source-end-frame
                                 :frames-per-second frames-per-second)
  (paste-movie-selection source-movie
                         destination-movie))


;;;-----------------------------------------------------------------------------
;;;
;;; Frame-Based Functions For Low-Level Movie Editing
;;;
;;;-----------------------------------------------------------------------------

(defmethod delete-movie-segment-in-frames ((my-movie movie)
                                           start-frame
                                           end-frame
                                           &key (frames-per-second *frames-per-second*))
  (let* ((start-time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (delete-movie-segment my-movie start-time duration)))

(defmethod insert-empty-movie-segment-in-frames ((my-movie movie)
                                       start-frame
                                       end-frame
                                       &key (frames-per-second *frames-per-second*))
  "Inserts empty space into a movie -- but cannot do this at the end of a movie"
  (let* ((start-time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (insert-empty-movie-segment my-movie start-time duration)))


(defmethod insert-movie-segment-in-frames ((my-source-movie movie) (my-destination-movie movie)
                                           &key
                                           source-movie-segment-start-frame
                                           source-movie-segment-end-frame
                                           destination-movie-insert-start-frame
                                           (frames-per-second *frames-per-second*))
  (let* ((source-in-time-value (frame-to-time my-source-movie source-movie-segment-start-frame :frames-per-second frames-per-second))
         (source-duration (frame-to-time my-source-movie (- source-movie-segment-end-frame source-movie-segment-start-frame) :frames-per-second frames-per-second))
         (destination-in-time-value (frame-to-time my-destination-movie destination-movie-insert-start-frame :frames-per-second frames-per-second)))
    (insert-movie-segment my-source-movie my-destination-movie
                          :source-movie-segment-start-time source-in-time-value
                          :source-movie-segment-duration source-duration
                          :destination-movie-insert-start-time destination-in-time-value)))

(defmethod scale-movie-segment-in-frames ((my-movie movie)
                                          start-frame
                                          old-end-frame
                                          new-end-frame
                                          &key (frames-per-second *frames-per-second*))
  (let* ((start-time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (old-duration (frame-to-time my-movie (- old-end-frame start-frame) :frames-per-second frames-per-second))
         (new-duration (frame-to-time my-movie (- new-end-frame start-frame) :frames-per-second frames-per-second)))
    (scale-movie-segment my-movie start-time old-duration new-duration)))


;;;-----------------------------------------------------------------------------
;;;
;;; Frame-Based Functions For Working With Movie Time
;;;
;;;-----------------------------------------------------------------------------

(defmethod get-movie-duration-in-frames ((my-movie movie) &key (frames-per-second *frames-per-second*))
  (time-to-frame my-movie (get-movie-duration my-movie) :frames-per-second frames-per-second))

(defmethod get-movie-time-in-frames ((my-movie movie) &key (frames-per-second *frames-per-second*))
  (time-to-frame my-movie (get-movie-time my-movie) :frames-per-second frames-per-second))

(defmethod get-movie-frame ((my-movie movie) &key (frames-per-second *frames-per-second*))
  (get-movie-time-in-frames my-movie :frames-per-second frames-per-second))

(defmethod set-movie-time-in-frames ((my-movie movie) frame &optional time-scale &key (frames-per-second *frames-per-second*))
  (let* ((time-scale (if time-scale time-scale (get-movie-time-scale my-movie)))
         (time (frame-to-time my-movie frame :frames-per-second frames-per-second)))
    (set-movie-time my-movie time time-scale)))

(defmethod set-movie-frame ((my-movie movie) frame &key (frames-per-second *frames-per-second*))
  (set-movie-time-value-in-frames my-movie frame :frames-per-second frames-per-second))

(defmethod set-movie-time-value-in-frames ((my-movie movie) frame &key (frames-per-second *frames-per-second*))
  (set-movie-time-value my-movie (frame-to-time my-movie frame :frames-per-second frames-per-second)))



;;;-----------------------------------------------------------------------------
;;;
;;; TEST CODE
;;;
;;;-----------------------------------------------------------------------------

(defun movie-test (&key (show-controller t))
  (make-instance 'movie-window
    :movie (make-instance 'movie)
    :show-controller show-controller))

;;; Show multiple movies.  Use the interface designer to move and scale...
(defun clip-library (paths)
  (let ((window (make-instance 'dialog
                  :window-title "Clip Library"
                  :view-size #@(400 400))))
    (dolist (path (directory paths))
      (make-instance 'movie-dialog-item
        :movie (make-instance 'movie :file path)
        :view-container window))))

(defun play-all (clip-library-window)
  (dolist (v (coerce (view-subviews clip-library-window) 'list))
    (when (typep v 'movie-view)
      (rewind-movie (slot-value v 'movie))
      (play-movie (slot-value v 'movie)))))


;;;-----------------------------------------------------------------------------
;;;
;;; START QUICKTIME
;;;
;;;-----------------------------------------------------------------------------

(initialize-quicktime)




;;;-----------------------------------------------------------------------------
;;;
;;; Debugging notes
;;;
;;;-----------------------------------------------------------------------------

;; New and changed functions from qt-objects.lisp v2.0 (Wednesday, 12/9/92)
;; Mods by Michael Korcuska (12/30/92)
;;
;; New Functions:
;;
;;    create-movie-file-from-fsspec
;;    get-movie-from-fsspec
;;    new-movie-path
;;    add-movie-resource-to-fsspec
;;    remove-movie-resource-from-fsspec
;;    update-movie-resource-fsspec
;;    flatten-movie-fsspec
;;    fsspec-exists-p
;;    valid-fsspec-p
;;
;; The changed functions are essentially those which created fsSpec records
;; and their callers.  It is now the responsibility of the caller to allocate
;; the fsSpec (with rlet in all cases)
;;
;; I've minimally tested all of these functions using movie-test, my own
;; application and individual calls to the resource functions.
;;
;; Comments:
;;   I think there's a problem with the class definitions, but I'm not sure.
;; When you create a movie from a file, the file information is no longer
;; important.  I don't think, therefore, that the file/refnum/id should be
;; part of the movie class.  Instead there should be a class movie-file with
;; that information.  This has many implications and would be a major rewrite,
;; which I certainly don't have time to do.
;;   I noticed the problem when working with the resource functions, which allow
;; me to create a new movie file and add an existing movie to it.  When I do this,
;; the file info associated with the existing movie gets set to the new file and
;; I have no way of accessing the old file info, which means I can't close it.
;; I don't know if there is a quick fix to this except to comment the resource
;; code in the distribution.  Let me know what you think.
;;
;;  Cheers,    Michael
;;